home *** CD-ROM | disk | FTP | other *** search
-
- /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
- #include <cmpinclude.h>
- #include "mislib.h"
- init_mislib(start,size,data)char *start;int size;object data;
- { register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
- Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
- base[0]= VV[0];
- (void)simple_symlispcall_no_event(VV[34],base+0,1);
- MM(VV[35],L2,start,size,data);
- base[0]= VV[9];
- base[1]= VV[10];
- (void)simple_symlispcall_no_event(VV[36],base+0,2);
- base[0]= VV[11];
- base[1]= VV[12];
- (void)simple_symlispcall_no_event(VV[36],base+0,2);
- MF(VV[37],L7,start,size,data);
- MF(VV[38],L8,start,size,data);
- data->v.v_self[27]=VV[27]=string_to_object(VV[27]);
- vs_top=sup;
- MF(VV[39],L9,start,size,data);
- MF(VV[40],L10,start,size,data);
- vs_top=vs_base=base;
- }
- /* macro definition for TIME */
-
- static L2()
- { register object *base=vs_base;
- register object *sup=base+VM3;
- vs_reserve(VM3);
- check_arg(2);
- vs_top=sup;
- {object V1=base[0]->c.c_cdr;
- if(endp(V1))invalid_macro_call();
- base[2]= (V1->c.c_car);
- V1=V1->c.c_cdr;
- if(!endp(V1))invalid_macro_call();}
- base[3]= list(2,VV[7],base[2]);
- base[4]= list(3,VV[5],VV[6],base[3]);
- base[5]= listA(6,VV[1],VV[2],VV[3],VV[4],base[4],VV[8]);
- vs_top=(vs_base=base+5)+1;
- return;
- }
- /* function definition for LEAP-YEAR-P */
-
- static L7()
- { register object *base=vs_base;
- register object *sup=base+VM4;
- vs_reserve(VM4);
- check_arg(1);
- vs_top=sup;
- TTL:;
- base[2]= base[0];
- base[3]= VV[13];
- vs_top=(vs_base=base+2)+2;
- Lmod();
- vs_top=sup;
- base[1]= vs_base[0];
- if(number_compare(small_fixnum(0),base[1])==0){
- goto T11;}
- base[1]= Cnil;
- vs_top=(vs_base=base+1)+1;
- return;
- T11:;
- base[3]= base[0];
- base[4]= VV[14];
- vs_top=(vs_base=base+3)+2;
- Lmod();
- vs_top=sup;
- base[2]= vs_base[0];
- if(!(((number_compare(small_fixnum(0),base[2])==0?Ct:Cnil))==Cnil)){
- goto T16;}
- base[2]= Ct;
- vs_top=(vs_base=base+2)+1;
- return;
- T16:;
- base[3]= base[0];
- base[4]= VV[15];
- vs_top=(vs_base=base+3)+2;
- Lmod();
- vs_top=sup;
- base[2]= vs_base[0];
- base[3]= (number_compare(small_fixnum(0),base[2])==0?Ct:Cnil);
- vs_top=(vs_base=base+3)+1;
- return;
- }
- /* function definition for NUMBER-OF-DAYS-FROM-1900 */
-
- static L8()
- { register object *base=vs_base;
- register object *sup=base+VM5;
- vs_reserve(VM5);
- check_arg(1);
- vs_top=sup;
- TTL:;
- base[1]= one_minus(base[0]);
- base[3]= number_minus(base[0],VV[16]);
- base[2]= number_times(base[3],VV[17]);
- base[4]= base[1];
- base[5]= VV[13];
- vs_top=(vs_base=base+4)+2;
- Lfloor();
- vs_top=sup;
- base[3]= vs_base[0];
- base[6]= base[1];
- base[7]= VV[14];
- vs_top=(vs_base=base+6)+2;
- Lfloor();
- vs_top=sup;
- base[5]= vs_base[0];
- base[4]= number_negate(base[5]);
- base[6]= base[1];
- base[7]= VV[15];
- vs_top=(vs_base=base+6)+2;
- Lfloor();
- vs_top=sup;
- base[5]= vs_base[0];
- base[6]= VV[18];
- vs_top=(vs_base=base+2)+5;
- Lplus();
- return;
- }
- /* function definition for DECODE-UNIVERSAL-TIME */
-
- static L9()
- { register object *base=vs_base;
- register object *sup=base+VM6;
- vs_reserve(VM6);
- if(vs_top-vs_base<1) too_few_arguments();
- if(vs_top-vs_base>2) too_many_arguments();
- vs_base=vs_base+1;
- if(vs_base>=vs_top){vs_top=sup;goto T37;}
- vs_top=sup;
- goto T38;
- T37:;
- base[1]= symbol_value(VV[19]);
- T38:;
- base[2]= Cnil;
- base[3]= Cnil;
- base[4]= Cnil;
- base[5]= Cnil;
- base[6]= Cnil;
- base[7]= Cnil;
- base[8]= Cnil;
- base[9]= number_times(base[1],VV[20]);
- base[0]= number_minus(base[0],base[9]);
- base[9]= base[0];
- base[10]= VV[12];
- vs_top=(vs_base=base+9)+2;
- Lfloor();
- if(vs_base<vs_top){
- base[5]= vs_base[0];
- vs_base++;
- }else{
- base[5]= Cnil;}
- if(vs_base<vs_top){
- base[0]= vs_base[0];
- }else{
- base[0]= Cnil;}
- vs_top=sup;
- base[9]= base[5];
- base[10]= VV[21];
- vs_top=(vs_base=base+9)+2;
- Lmod();
- vs_top=sup;
- base[8]= vs_base[0];
- base[9]= base[0];
- base[10]= VV[20];
- vs_top=(vs_base=base+9)+2;
- Lfloor();
- if(vs_base<vs_top){
- base[4]= vs_base[0];
- vs_base++;
- }else{
- base[4]= Cnil;}
- if(vs_base<vs_top){
- base[0]= vs_base[0];
- }else{
- base[0]= Cnil;}
- vs_top=sup;
- base[9]= base[0];
- base[10]= VV[22];
- vs_top=(vs_base=base+9)+2;
- Lfloor();
- if(vs_base<vs_top){
- base[3]= vs_base[0];
- vs_base++;
- }else{
- base[3]= Cnil;}
- if(vs_base<vs_top){
- base[2]= vs_base[0];
- }else{
- base[2]= Cnil;}
- vs_top=sup;
- base[10]= base[5];
- base[11]= VV[23];
- vs_top=(vs_base=base+10)+2;
- Lfloor();
- vs_top=sup;
- base[9]= vs_base[0];
- base[7]= number_plus(VV[16],base[9]);
- base[9]= Cnil;
- T65:;
- base[12]= base[7];
- vs_top=(vs_base=base+12)+1;
- L8();
- vs_top=sup;
- base[11]= vs_base[0];
- base[9]= number_minus(base[5],base[11]);
- base[10]= base[9];
- base[12]= base[7];
- vs_top=(vs_base=base+12)+1;
- L7();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T75;}
- base[11]= VV[23];
- goto T73;
- T75:;
- base[11]= VV[17];
- T73:;
- if(!(number_compare(base[10],base[11])<0)){
- goto T66;}
- base[5]= one_plus(base[9]);
- goto T63;
- T66:;
- base[7]= number_plus(base[7],VV[24]);
- goto T65;
- T63:;
- base[9]= base[7];
- vs_top=(vs_base=base+9)+1;
- L7();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T84;}
- if(!(number_compare(base[5],VV[22])==0)){
- goto T88;}
- base[9]= base[2];
- base[10]= base[3];
- base[11]= base[4];
- base[12]= VV[25];
- base[13]= VV[26];
- base[14]= base[7];
- base[15]= base[8];
- base[16]= Cnil;
- base[17]= base[1];
- vs_base=base+9;vs_top=base+18;
- return;
- T88:;
- if(!(number_compare(base[5],VV[22])>0)){
- goto T84;}
- base[5]= number_minus(base[5],VV[24]);
- T84:;
- base[9]= VV[27];
- T105:;
- if(!(number_compare(base[5],car(base[9]))<=0)){
- goto T106;}
- base[10]= make_fixnum(length(base[9]));
- base[6]= number_minus(VV[28],base[10]);
- goto T103;
- T106:;
- base[5]= number_minus(base[5],car(base[9]));
- base[9]= cdr(base[9]);
- goto T105;
- T103:;
- base[9]= base[2];
- base[10]= base[3];
- base[11]= base[4];
- base[12]= base[5];
- base[13]= base[6];
- base[14]= base[7];
- base[15]= base[8];
- base[16]= Cnil;
- base[17]= base[1];
- vs_base=base+9;vs_top=base+18;
- return;
- }
- /* function definition for ENCODE-UNIVERSAL-TIME */
-
- static L10()
- { register object *base=vs_base;
- register object *sup=base+VM7;
- vs_reserve(VM7);
- if(vs_top-vs_base<6) too_few_arguments();
- if(vs_top-vs_base>7) too_many_arguments();
- vs_base=vs_base+6;
- if(vs_base>=vs_top){vs_top=sup;goto T125;}
- vs_top=sup;
- goto T126;
- T125:;
- base[6]= symbol_value(VV[19]);
- T126:;
- base[2]= number_plus(base[2],base[6]);
- base[7]= VV[29];
- base[8]= base[5];
- base[9]= VV[30];
- vs_top=(vs_base=base+7)+3;
- Lmonotonically_nondecreasing();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T130;}
- symlispcall_no_event(VV[41],base+8,0);
- Llist();
- vs_top=sup;
- base[7]= vs_base[0];
- base[8]= car(base[7]);
- base[9]= cadr(base[7]);
- base[10]= caddr(base[7]);
- base[11]= cadddr(base[7]);
- base[12]= car(cddddr(base[7]));
- base[13]= cadr(cddddr(base[7]));
- base[14]= caddr(cddddr(base[7]));
- base[15]= cadddr(cddddr(base[7]));
- base[16]= nth(8,base[7]);
- base[18]= base[13];
- base[19]= VV[14];
- vs_top=(vs_base=base+18)+2;
- Lmod();
- vs_top=sup;
- base[17]= vs_base[0];
- base[18]= number_minus(base[13],base[17]);
- base[5]= number_plus(base[5],base[18]);
- base[17]= number_minus(base[5],base[13]);
- if(!(number_compare(base[17],VV[32])<0)){
- goto T153;}
- base[5]= number_plus(base[5],VV[14]);
- goto T130;
- T153:;
- base[17]= number_minus(base[5],base[13]);
- if(!(number_compare(base[17],VV[33])>=0)){
- goto T130;}
- base[5]= number_minus(base[5],VV[14]);
- T130:;
- base[7]= base[5];
- vs_top=(vs_base=base+7)+1;
- L7();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T160;}
- if(number_compare(base[4],VV[26])>0){
- goto T159;}
- T160:;
- base[3]= number_minus(base[3],VV[24]);
- T159:;
- base[9]= base[3];
- base[11]= base[5];
- vs_top=(vs_base=base+11)+1;
- L8();
- vs_top=sup;
- base[10]= vs_base[0];
- {object V2;
- base[11]= VV[27];
- base[12]= number_minus(VV[28],base[4]);
- vs_top=(vs_base=base+11)+2;
- Lbutlast();
- vs_top=sup;
- V2= vs_base[0];
- vs_top=base+11;
- while(!endp(V2))
- {vs_push(car(V2));V2=cdr(V2);}
- vs_base=base+9;}
- Lplus();
- vs_top=sup;
- base[8]= vs_base[0];
- base[7]= number_times(base[8],VV[12]);
- base[8]= number_times(base[2],VV[20]);
- base[9]= number_times(base[1],VV[22]);
- base[10]= base[0];
- vs_top=(vs_base=base+7)+4;
- Lplus();
- return;
- }
-